home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / basappl9.arc / TAXDEDCT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-08-02  |  7.0 KB  |  241 lines
  1. 1000  '>>>THIS PROGRAM RECORDS INCOME TAX DEDUCTIONS
  2. 1100  '>>>HARRY G. FRIEDMAN
  3. 1200  '>>>945 Dudley Drive
  4. 1300  '>>>Shreveport, LA 71104
  5. 1400  '>>>v 1.0
  6. 1500  '
  7. 1600  '>>>Filename=TAXDEDCT.BAS
  8. 1700  '>>>DATA FILE IS RANDOM ACCESS.
  9. 1800  '>>>CODING SCHEME IS:
  10. 1900  '>>>       01/XX - Contributions
  11. 2000  '>>>       02/XX - Medical
  12. 2100  '>>>       03/XX - Interest
  13. 2200  '>>>       04/XX - Taxes
  14. 2300  '>>>THE XX PORTION OF THE CODE IS ASSIGNED TO THE PAYEE IN NUMERICAL
  15. 2400  '>>>SEQUENCE, ONE CODE NUMBER FOR EACH INDIVIDUAL PAYEE.
  16. 2500  '>>>DATES AND CODES ARE ENTERED WITHOUT "/" - AMOUNTS WITH ONLY THE
  17. 2600  '>>>DECIMAL POINT (.).
  18. 2700  '>>>MENU ITEM 6 PRINTS A LIST AND TOTAL IN DATA ENTRY FORMAT.
  19. 2800  '>>>MENU ITEM 7 PRINTS A LIST AND TOTALS SORTED BY CATAGORY AND PAYEE.
  20. 2900  '
  21. 3000  '>>>Permission is hereby granted for the unlimited use or reproduction
  22. 3100  '>>>of this program.
  23. 3200  '>>>Notification of changes or additions will be appreciated.
  24. 3300  'FILENAME=TAXDEDCT - DATA FILENAME=TAXDED.DAT
  25. 3400  KEY OFF:CLS
  26. 3500  DEFINT I
  27. 3600  OPTION BASE 1
  28. 3700  DAT=250
  29. 3800  DIM REC$(DAT)
  30. 3900  OPEN "B:TAXDED.DAT" AS #1 LEN=64
  31. 4000  FIELD #1,1 AS US$,6 AS DTE$,4 AS CDE$,45 AS PAY$,8 AS AMT$
  32. 4100  FIELD #1,64 AS RECORD$
  33. 4200  '
  34. 4300  '>>>***<<<
  35. 4400  '
  36. 4500  PRINT TAB(40) "MENU"
  37. 4600  PRINT
  38. 4700  PRINT TAB(30)1; "INITIALIZE the FILE"
  39. 4800  PRINT TAB(30)2; "CREATE or ADD a RECORD"
  40. 4900  PRINT TAB(30)3; "DISPLAY a RECORD"
  41. 5000  PRINT TAB(30)4; "EDIT a RECORD"
  42. 5100  PRINT TAB(30)5; "DELETE a RECORD"
  43. 5200  PRINT TAB(30)6; "PRINT HARDCOPY"
  44. 5300  PRINT TAB(30)7; "SORT and PRINT"
  45. 5400  PRINT TAB(30)8; "EXIT - RETURN to BASIC"
  46. 5500  PRINT:INPUT "SELECT FUNCTION ",ISELCT
  47. 5600  IF (ISELCT<1) OR (ISELCT>8) THEN PRINT "BAD SELECTION - PLEASE REENTER":        GOTO 5500
  48. 5700  ON ISELCT GOSUB 6000,7500,11000,12200,15400,17100,18900,24700
  49. 5800  GOTO 4500
  50. 5900  '
  51. 6000  '>>>INITIALIZE FILE ROUTINE<<<
  52. 6100  '
  53. 6200  INPUT "ARE YOU SURE";ANS$:IF ANS$<>"Y" THEN RETURN
  54. 6300  LSET RECORD$=CHR$(255)
  55. 6400  FOR I=1 TO 250
  56. 6500  PUT #1,I
  57. 6600  NEXT
  58. 6700  RETURN
  59. 6800  '
  60. 6900  '>>>SEQUENCE NUMBER ROUTINE<<<
  61. 7000  '
  62. 7100  INPUT "SEQUENCE NUMBER ",ISEQ
  63. 7200  IF (ISEQ<1) OR (ISEQ>250) THEN PRINT "BAD SEQUENCE NUMBER-PLEASE REENTER":      GOTO 7100 ELSE GET #1,ISEQ
  64. 7300  IF USEFLG=1 THEN 8600 ELSE RETURN
  65. 7400  '
  66. 7500  '>>>FILE ENTRY ROUTINE<<<
  67. 7600  '
  68. 7700  USEFLG=0
  69. 7800  MODE$=""
  70. 7900  INPUT "CREATE THE FILE or ADD A RECORD? - REPLY 'C' or 'A' ",MODE$
  71. 8000  PRINT
  72. 8100  IF MODE$="C" THEN ISEQ=1:GOTO 9400 ELSE MODE$="A"
  73. 8200  INPUT "Is a deleted record SEQUENCE NUMBER to be reused? - Reply Y/N ",         ANS$:PRINT
  74. 8300  IF ANS$<>"Y" THEN 8800 ELSE USEFLG=1
  75. 8400  IF ASC(US$)<>255 THEN INPUT "OVERWRITE";X$:IF X$<>"Y" THEN 4500
  76. 8500  GOTO 6900
  77. 8600  PRINT:PRINT "Inserting record at SEQUENCE NUMBER";ISEQ:PRINT
  78. 8700  GOTO 9400
  79. 8800  PRINT:PRINT "Adding record to file.":PRINT
  80. 8900  ISEQ=1
  81. 9000  FOR X=1 TO LOF(1)/128
  82. 9100  GET #1,ISEQ
  83. 9200  IF DTE$<>"ZZZZZZ" THEN ISEQ=ISEQ+1 ELSE PRINT ISEQ;"is next SEQUENCE";          " NUMBER for ADD":GOTO 9400
  84. 9300  NEXT
  85. 9400  LSET US$=CHR$(0)
  86. 9500  INPUT "DATE -   ",CALENDAR$
  87. 9600  LSET DTE$=CALENDAR$
  88. 9700  INPUT "CODE -   ",CODE$
  89. 9800  LSET CDE$=CODE$
  90. 9900  INPUT "PAYEE -  ",PAYEE$
  91. 10000  LSET PAY$=PAYEE$
  92. 10100  INPUT "AMOUNT - ",AMOUNT$
  93. 10200  RSET AMT$=AMOUNT$
  94. 10300  PUT #1,ISEQ
  95. 10400  IF USEFLG=1 THEN USEFLG=0:GOTO 4500
  96. 10500  INPUT "MORE NEW DATA";ANS$:IF ANS$="Y" THEN ISEQ=ISEQ+1:GOTO 9400 ELSE         ISEQ=ISEQ+1:LSET DTE$="ZZZZZZ"
  97. 10600  LSET CDE$=CHR$(32):LSET PAY$=CHR$(32)
  98. 10700  LSET AMT$=CHR$(32)
  99. 10800  PUT #1,ISEQ:RETURN
  100. 10900  '
  101. 11000  '>>>DISPLAY ROUTINE<<<
  102. 11100  '
  103. 11200  GOSUB 6900
  104. 11300  PRINT "SEQUENCE NUMBER ",ISEQ
  105. 11400  PRINT LEFT$(DTE$,2)+"/"+MID$(DTE$,3,2)+"/"+RIGHT$(DTE$,2)
  106. 11500  PRINT LEFT$(CDE$,2)+"/"RIGHT$(CDE$,2)
  107. 11600  PRINT PAY$
  108. 11700  PRINT AMT$
  109. 11800  INPUT "MORE RECORDS FOR DISPLAY - Y/N or E";ANS$
  110. 11900  IF (ANS$<>"Y") AND (ANS$<>"N") AND (ANS$<>"E") THEN 11800
  111. 12000  IF (ANS$="Y") THEN 11000 ELSE IF (ANS$="N") THEN RETURN ELSE PRINT:             PRINT "NEXT EDIT"
  112. 12100  '
  113. 12200  '>>>FILE EDIT ROUTINE<<<
  114. 12300  '
  115. 12400  PRINT:GOSUB 6800
  116. 12500  PRINT TAB(28)"FIELD TO CHANGE MENU"
  117. 12600  PRINT
  118. 12700  PRINT TAB(30)1;"DATE"
  119. 12800  PRINT TAB(30)2;"CODE"
  120. 12900  PRINT TAB(30)3;"PAYEE"
  121. 13000  PRINT TAB(30)4;"AMOUNT"
  122. 13100  PRINT:INPUT "WHICH FIELD TO CHANGE";FLD
  123. 13200  IF (FLD<1) OR (FLD>4) THEN PRINT "WRONG FIELD NUMBER":GOTO 13100
  124. 13300  ON FLD GOSUB 13500,13900,14300,14700
  125. 13400  GOTO 12500
  126. 13500  PRINT "CURRENT RECORD IS ";DTE$
  127. 13600  INPUT "NEW DATE          ",CALENDAR$
  128. 13700  LSET DTE$=CALENDAR$
  129. 13800  GOTO 15000
  130. 13900  PRINT "CURRENT RECORD IS ";CDE$
  131. 14000  INPUT "NEW CODE          ",CODE$
  132. 14100  LSET CDE$=CODE$
  133. 14200  GOTO 15000
  134. 14300  PRINT "CURRENT RECORD IS ";PAY$
  135. 14400  INPUT "NEW PAYEE         ",PAYEE$
  136. 14500  LSET PAY$=PAYEE$
  137. 14600  GOTO 15000
  138. 14700  PRINT "CURRENT RECORD IS ";AMT$
  139. 14800  INPUT "NEW AMOUNT       ",AMOUNT$
  140. 14900  RSET AMT$=AMOUNT$
  141. 15000  INPUT "ANY MORE CHANGES";ANS$
  142. 15100  IF ANS$="Y" THEN 13100 ELSE PUT #1,ISEQ:GOSUB 11400
  143. 15200  GOTO 4500
  144. 15300  '
  145. 15400  '>>>DELETE RECORD ROUTINE<<<
  146. 15500  '
  147. 15600  GOSUB 6900
  148. 15700  PRINT "SEQUENCE NUMBER";ISEQ
  149. 15800  PRINT LEFT$(DTE$,2)+"/"+MID$(DTE$,3,2)+"/"+RIGHT$(DTE$,2)
  150. 15900  PRINT LEFT$(CDE$,2)+"/"+RIGHT$(CDE$,2)
  151. 16000  PRINT PAY$
  152. 16100  PRINT AMT$
  153. 16200  INPUT "IS THIS THE RECORD TO DELETE";ANS$:IF ANS$<>"Y" THEN 4500
  154. 16300  LSET DTE$=CHR$(32)
  155. 16400  LSET CDE$=CHR$(32)
  156. 16500  LSET PAY$=CHR$(32)
  157. 16600  LSET AMT$=CHR$(32)
  158. 16700  PUT #1,ISEQ
  159. 16800  PRINT "THIS RECORD DELETED   ";ISEQ
  160. 16900  INPUT "ANY MORE DELETIONS";ANS$:IF ANS$="Y" THEN 15400 ELSE RETURN
  161. 17000  '
  162. 17100  '>>>HARDCOPY ROUTINE<<<
  163. 17200  '
  164. 17300  TOT=0
  165. 17400  LINCNT=0
  166. 17500  PRINT
  167. 17600  PRINT TAB(25):COLOR 1
  168. 17700  PRINT TAB(25)"PRINTING OUT DATA IN ENTRY SEQUENCE":COLOR 7:PRINT
  169. 17800  LPRINT TAB(62)"DATE   ";DATE$:LPRINT
  170. 17900  LPRINT "SEQ";TAB(8)"DATE";TAB(16)"CODE";TAB(41)"PAYEE";TAB(73)"AMOUNT"
  171. 18000  LPRINT "===";TAB(8)"====";TAB(16)"====";TAB(41)"=====";TAB(73)"======"
  172. 18100  LINCNT=LINCNT+4
  173. 18200  ISEQ=1
  174. 18300  GET #1,ISEQ
  175. 18400  LPRINT ISEQ;TAB(6)DTE$;TAB(16)CDE$;TAB(23)PAY$;TAB(71)AMT$
  176. 18500  TOT=TOT+VAL(AMT$)
  177. 18600  LINCNT=LINCNT+1:IF LINCNT=>58 THEN LPRINT CHR$(12):LINCNT=0:ELSE                GOTO 18700
  178. 18700  IF DTE$<>"ZZZZZZ" THEN ISEQ=ISEQ+1:GOTO 18300 ELSE LPRINT TAB(71)TOT:           LPRINT CHR$(12):GOTO 4500
  179. 18800  '
  180. 18900  '>>>SORT ROUTINE<<<
  181. 19000  '
  182. 19100  ISEQ=1
  183. 19200  FOR S=1 TO DAT
  184. 19300  GET #1,ISEQ
  185. 19400  REC$(S)=INPUT$(64,#1)
  186. 19500  IF ASC(US$)=0 OR ASC(US$)=32 THEN ISEQ=ISEQ+1:GOTO 19600 ELSE GOTO 19700
  187. 19600  NEXT
  188. 19700  COLOR 16,7:PRINT "SORT IN PROGRESS ";TIME$;:COLOR 7,0
  189. 19800  D=S:FLAG=0
  190. 19900  D=INT((D+1)/2)
  191. 20000  FOR Q=1 TO S-D
  192. 20100  IF MID$(REC$(Q),8,4)+MID$(REC$(Q),2,6)<=MID$(REC$(Q+D),8,4)+MID$(REC$           (Q+D),2,6) THEN 20200 ELSE SWAP REC$(Q),REC$(Q+D):FLAG=1
  193. 20200  NEXT
  194. 20300  IF FLAG=1 THEN FLAG=0:GOTO 20000
  195. 20400  IF D>1 THEN 19900
  196. 20500  PRINT:COLOR 0,7:PRINT "SORT COMPLETED   ";TIME$;:COLOR 7,0:PRINT
  197. 20600  COLOR 7,0
  198. 20700  '
  199. 20800  '>>>PRINT ROUTINE<<<
  200. 20900  '
  201. 21000  PRINT TAB(30):COLOR 1
  202. 21100  PRINT TAB(30)"PRINTING SORTED DATA":COLOR 7:PRINT
  203. 21200  LINCNT=0
  204. 21300  LPRINT TAB(20)"INCOME TAX DEDUCTIONS SORTED BY CATAGORY"
  205. 21400  LPRINT TAB(62)"DATE  ";DATE$:LPRINT
  206. 21500  LINCNT=LINCNT+2
  207. 21600  LPRINT "                       DEDUCTIONS              CODES"
  208. 21700  LPRINT "                       ==========              ====="
  209. 21800  LPRINT "                     Contributions             01/XX"
  210. 21900  LPRINT "                     Medical                   02/XX"
  211. 22000  LPRINT "                     Interest                  03/XX"
  212. 22100  LPRINT "                     Taxes                     04/XX"
  213. 22200  LPRINT "                    ================================"
  214. 22300  LPRINT TAB(3)"DATE";TAB(12)"CODE";TAB(41)"PAYEE";TAB(73)"AMOUNT"
  215. 22400  LPRINT TAB(3)"====";TAB(12)"====";TAB(41)"=====";TAB(73)"======"
  216. 22500  LINCNT=LINCNT+10
  217. 22600  SUM=0
  218. 22700  TOT=0
  219. 22800  G.TOT=0
  220. 22900  SUM$="0101"
  221. 23000  FOR S=1 TO Q
  222. 23100  IF (MID$(REC$(S),2,6)="ZZZZZZ") OR (VAL(MID$(REC$(S),57,8))=0) THEN             REC$(S)=STRING$(64,32):LPRINT REC$(S):GOTO 24200
  223. 23200  CODE$=MID$(REC$(S),8,4)
  224. 23300  IF SUM$<>CODE$ THEN LPRINT TAB(51)"TOTAL";TAB(60)USING "######,.##";TOT:        TOT=0:SUM$=CODE$:LINCNT=LINCNT+1
  225. 23400  LPRINT MID$(REC$(S),2,2)+"/"+MID$(REC$(S),4,2)+"/"+MID$(REC$(S),6,2);
  226. 23500  LPRINT TAB(12)MID$(REC$(S),8,2)+"/"+MID$(REC$(S),10,2);
  227. 23600  LPRINT TAB(20)MID$(REC$(S),12,45);
  228. 23700  LPRINT TAB(70)USING "######,.##";VAL(MID$(REC$(S),57,8))
  229. 23800  SUM=VAL(MID$(REC$(S),57,8))
  230. 23900  TOT=TOT+SUM
  231. 24000  G.TOT=G.TOT+SUM
  232. 24100  LINCNT=LINCNT+1:IF LINCNT=>58 THEN LPRINT CHR$(12):LINCNT=0 ELSE                GOTO 24200
  233. 24200  NEXT S
  234. 24300  LPRINT:LPRINT TAB(55)"GRAND TOTAL";TAB(70)USING "######,.##";G.TOT
  235. 24400  LPRINT CHR$(12)
  236. 24500  RETURN
  237. 24600  '
  238. 24700  '>>>EXIT ROUTINE<<<
  239. 24800  '
  240. 24900  CLOSE:KEY ON:CLS
  241.